home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / darc31.zip / DEARCUNP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  2KB  |  113 lines
  1. (**
  2.  *
  3.  *  Module:       dearcunp.pas
  4.  *  Description:  unPacking routines (run-length encoding)
  5.  *
  6.  *  Revision History:
  7.  *    7-26-88: unitized for Turbo v4.0
  8.  *
  9. **)
  10.  
  11.  
  12. unit dearcunp;
  13.  
  14. interface
  15.  
  16. uses
  17.   dearcglb,
  18.   dearcabt,
  19.   dearcio;
  20.  
  21.   procedure putc_unp(c : integer);
  22.   procedure putc_ncr(c : integer);
  23.   function getc_unp : integer;
  24.  
  25.  
  26. implementation
  27.  
  28. (*
  29.  *  definitions for unpack
  30.  *)
  31. Const
  32.   DLE = $90;
  33.  
  34. Var
  35.   lastc  : integer;
  36.  
  37. (**
  38.  *
  39.  *  Name:         procedure putc_unp
  40.  *  Description:  put one character to extracted file,  update CRC
  41.  *  Parameters:   value -
  42.  *                  c : integer - value to write
  43.  *
  44. **)
  45. procedure putc_unp(c : integer);
  46. begin
  47.   crcval := ((crcval shr 8) and $00FF) xor crctab[(crcval xor c) and $00FF];
  48.   put_ext(c)
  49. end; (* proc putc_unp *)
  50.  
  51.  
  52. (**
  53.  *
  54.  *  Name:         procedure putc_ncr
  55.  *  Description:  put one char,  checking for run-length compression
  56.  *  Parameters:   value -
  57.  *                  c : integer - value to write
  58.  *
  59. **)
  60. procedure putc_ncr(c : integer);
  61. begin
  62.   case state of
  63.     NOHIST :
  64.       if c = DLE then
  65.         state := INREP
  66.       else
  67.         begin
  68.           lastc := c;
  69.           putc_unp(c)
  70.         end;
  71.  
  72.     INREP  :
  73.       begin
  74.         if c = 0 then
  75.           putc_unp(DLE)
  76.         else
  77.           begin
  78.             c := c - 1;
  79.             while (c <> 0) do
  80.               begin
  81.                 putc_unp(lastc);
  82.                 c := c - 1
  83.               end
  84.             end;
  85.  
  86.         state := NOHIST
  87.       end
  88.   end  (* case *)
  89. end; (* proc putc_ncr *)
  90.  
  91.  
  92. (**
  93.  *
  94.  *  Name:         function getc_unp : integer
  95.  *  Description:  get one character from archive
  96.  *  Parameters:   none
  97.  *  Returns:      character read
  98.  *
  99. **)
  100. function getc_unp : integer;
  101. begin
  102.   if size = 0.0 then
  103.     getc_unp := -1
  104.   else
  105.     begin
  106.       size := size - 1;
  107.       getc_unp := get_arc
  108.     end;
  109. end; (* func getc_unp *)
  110.  
  111. end.
  112.  
  113.